home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_12946.txt < prev    next >
Text File  |  1990-04-17  |  8KB  |  286 lines
  1. -- card: 12946 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: ResList
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XFCN,ResList,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (button)
  14. -- low flags: 00
  15. -- high flags: A003
  16. -- rect: left=299 top=300 right=322 bottom=438
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 1
  20. -- font id: 0
  21. -- text size: 12
  22. -- style flags: 0
  23. -- line height: 16
  24. -- part name: Show Pascal Source
  25. ----- HyperTalk script -----
  26. on mouseUp
  27.   set the visible of card field 1 to not the visible of card field 1
  28.   if the visible of card field 1 is true then
  29.     set the name of me to "Hide Pascal Source"
  30.   else set the name of me to "Show Pascal Source"
  31. end mouseUp
  32.  
  33.  
  34.  
  35. -- part 2 (field)
  36. -- low flags: 81
  37. -- high flags: 2007
  38. -- rect: left=12 top=26 right=298 bottom=491
  39. -- title width / last selected line: 0
  40. -- icon id / first selected line: 0 / 0
  41. -- text alignment: 0
  42. -- font id: 22
  43. -- text size: 10
  44. -- style flags: 0
  45. -- line height: 13
  46. -- part name: Source
  47.  
  48.  
  49. -- part contents for background part 16
  50. ----- text -----
  51. RESLIST XFCN version 1.0.1
  52. Kevin Calhoun
  53.  
  54. ResList returns information about the resources contained in a file.  It returns one line of information for each resource contained in the target file.  Each line contains four items separated by commas.  Item 1 will be the resource type, item 2 the resource name, item 3 the resource ID, and item 4 the size of the resource in bytes.
  55.  
  56. What follows is excerpted from the information ResList returns when the target file is the famous ResCopy XCMD stack:
  57.  
  58.    XCMD,ResCopy,10000,23002
  59.    CURS,Mouse!,1000,68
  60.    XFCN,NewFileName,914,1334
  61.    XFCN,FileName,913,2040
  62.  
  63. INVOKING RESLIST
  64.  
  65. get ResList(<"targetFile">)
  66.  
  67. The targetFile parameter is optional.  If it is not included, ResList returns information about the current stack.  If it is included and represents the full pathname of an existing resource file, ResList returns information about that file.
  68.  
  69. Revision history:
  70. 15 March 1989 -- first release.
  71. 11 June 1989 -- Now returns empty when file has no resource fork.
  72.  
  73. -- part contents for card part 2
  74. ----- text -----
  75. UNIT ResListUnit;
  76.  
  77. { ResList XFCN ┬⌐1989 by the Trustees of Dartmouth College }
  78. { Written by Kevin Calhoun }
  79.  
  80. { This source compatible with MPW Pascal 3.0 }
  81.  
  82. (*
  83. Pascal ResList.p
  84. Link -m ENTRYPOINT Γêé
  85.      -o "YourFile" Γêé
  86.      -rt XFCN=7509 Γêé
  87.      -sn Main=ResList Γêé
  88.      ResList.p.o Γêé
  89.     "{Libraries}"interface.o Γêé
  90.     "{PLibraries}"Paslib.o Γêé
  91.     "{Libraries}"HyperXLib.o
  92. *)
  93.  
  94. {$S ResList }
  95. {$R-}
  96.  
  97. interface
  98.   USES
  99.     Types,
  100.     Memory,
  101.     Resources,
  102.     Files,
  103.     ToolUtils,
  104.     OSUtils,
  105.     SysEqu,
  106.     Errors,
  107.     HyperXCmd;
  108.  
  109.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  110.  
  111. IMPLEMENTATION
  112.  
  113. {-----------------------------------------------------------------}
  114.  
  115.   PROCEDURE ResList (paramPtr: XCMDPtr);  FORWARD;
  116.  
  117.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  118.   BEGIN
  119.     ResList(paramPtr);
  120.   END;
  121.  
  122.   FUNCTION AppendString (h: Handle; str: Str255): OSErr;
  123.   BEGIN
  124.     AppendString := PtrAndHand(POINTER(ORD4(@str)+1), h, LENGTH(str));
  125.   END;
  126.  
  127.   FUNCTION MyOpenResFile(fileName: Str255; VAR refNum: INTEGER;
  128.                           VAR wasOpen: BOOLEAN): OSErr;
  129.     TYPE
  130.       HandlePtr = ^Handle;
  131.     VAR
  132.       oldTopMapHndl: Handle;
  133.   BEGIN
  134.     MyOpenResFile := noErr;
  135.     oldTopMapHndl := HandlePtr(TopMapHndl)^;  { remember current TopMapHndl }
  136.     refNum := OpenResFile(fileName);          { open resource file }
  137.     IF (refNum = -1) THEN { error opening file }
  138.       BEGIN
  139.       MyOpenResFile := ResError;
  140.       EXIT(MyOpenResFile);
  141.       END
  142.     ELSE
  143.       IF (oldTopMapHndl = HandlePtr(TopMapHndl)^) THEN wasOpen := TRUE
  144.         { no change -- it was open }
  145.       ELSE wasOpen := FALSE;
  146.         { res file wasn't open before }
  147.   END;
  148.   
  149.   FUNCTION GetTheNameOfThisStack (paramPtr : XCMDPtr; var str: Str255): OSErr;
  150.     VAR
  151.       theResult : Handle;
  152.       theLength : Longint;
  153.       err: OSErr;
  154.   BEGIN
  155.     err := noErr;
  156.     str := 'word 2 of the long name of this stack';
  157.     theResult := EvalExpr(paramPtr, str);
  158.     err := paramPtr^.result;
  159.     IF (theResult <> NIL) and (err = noErr) THEN
  160.       BEGIN
  161.       theLength := StringLength(paramPtr, theResult^);
  162.       ZeroToPas(paramPtr, theResult^, str);
  163.       DisposHandle(theResult);
  164.       DELETE(str,theLength,1);
  165.       DELETE(str,1,1);
  166.       END
  167.     ELSE str := '';
  168.     GetTheNameOfThisStack := err;
  169.   END;
  170.  
  171.   PROCEDURE ResList (paramPtr: XCMDPtr);
  172.     LABEL
  173.       98, 99, 100;
  174.     TYPE
  175.       Str1 = String[1];
  176.     VAR
  177.       paramCount : INTEGER;
  178.       fileName : Str255;
  179.       theRefNum : INTEGER;
  180.       saveResFile: INTEGER;
  181.       numTypes, numResources: INTEGER;
  182.       theType: ResType;
  183.       i, j: INTEGER;
  184.       theResource: Handle;
  185.       theID: INTEGER;
  186.       name, typeStr, IDStr, sizeStr: Str255;
  187.       resourceList: Handle;
  188.       comma, zero, return: Str1;
  189.       alreadyOpen: BOOLEAN;
  190.       nullPos: INTEGER;
  191.       err: OSErr;
  192.       curs: CursHandle;
  193.       zeroPtr: Ptr;
  194.  
  195.     PROCEDURE PassReturnValue (errMsg : Str255); { set theResult }
  196.     BEGIN
  197.       paramPtr^.returnValue := PasToZero(paramPtr, errMsg);
  198.     END;
  199.  
  200.   BEGIN
  201.     err := noErr;
  202.     paramCount := paramPtr^.paramCount;
  203.     IF paramCount > 1 THEN
  204.       BEGIN
  205.       PassReturnValue('ResList XFCN 1.0.1, 11 June 1989, ┬⌐1989 Dartmouth College');
  206.       GOTO 100;
  207.       END;
  208.  
  209.     curs := GetCursor(watchCursor);
  210.     SetCursor(curs^^);
  211.  
  212.     saveResFile := CurResFile;  { save the current resource file }
  213.     IF paramCount > 0 THEN
  214.       ZeroToPas(paramPtr, paramPtr^.params[1]^, fileName)
  215.     ELSE
  216.       BEGIN
  217.       err := GetTheNameOfThisStack(paramPtr,fileName);
  218.       IF err <> noErr THEN GOTO 99;
  219.       END;
  220.       
  221.     err := MyOpenResFile(fileName, theRefNum, alreadyOpen);
  222.     IF err <> noErr THEN GOTO 99;
  223.  
  224.     SetResLoad(FALSE);
  225.     UseResFile(theRefNum);
  226.     numTypes := Count1Types;
  227.     IF numTypes = 0 THEN GOTO 98;
  228.       
  229.     resourceList := NewHandle(0);
  230.     err := MemError;
  231.     IF err <> noErr then GOTO 98;
  232.       
  233.     comma := ',';
  234.     zero := comma;
  235.     zero[1] := CHR(0);
  236.     return := comma;
  237.     return[1] := CHR($0D);
  238.     typeStr[0] := CHR(4);
  239.     FOR i := 1 to numTypes DO
  240.       BEGIN
  241.       Get1IndType(theType, i);
  242.       numResources := Count1Resources(theType);
  243.       FOR j := 1 to numResources DO
  244.         BEGIN
  245.         theResource := Get1IndResource(theType, j);
  246.         GetResInfo(theResource, theID, theType, name);
  247.           { remove nulls from resource name }
  248.         nullPos := POS(zero, name);
  249.         WHILE nullPos > 0 DO
  250.           BEGIN
  251.           DELETE(name, nullPos, 1);
  252.           nullPos := POS(zero, name);
  253.           END;
  254.         NumToStr(paramPtr, theID, IDStr);
  255.         NumToStr(paramPtr, SizeResource(theResource), sizeStr);
  256.         BlockMove(@theType, POINTER(ORD4(@typeStr)+1), 4);
  257.         err := AppendString(resourceList, 
  258.           CONCAT(typeStr, ',', name, ',', IDStr, ',', sizeStr, return));
  259.         IF err <> noErr THEN
  260.           BEGIN
  261.           DisposHandle(resourceList);
  262.           GOTO 98;
  263.           END;
  264.         END;
  265.       END;
  266.     HLock(resourceList);
  267.     zeroPtr := POINTER(ORD4(resourceList^)+GetHandleSize(resourceList)-1);
  268.     zeroPtr^ := 0;
  269.     HUnlock(resourceList);
  270.     paramPtr^.returnValue := resourceList;
  271.  
  272.     98: IF NOT alreadyOpen THEN CloseResFile(theRefNum);
  273.     SetResLoad(TRUE);
  274.     UseResFile(saveResFile);
  275.     
  276.     99: InitCursor;
  277.  
  278.     100: IF (err <> noErr) AND (err <> eofErr) THEN
  279.       BEGIN
  280.       NumToStr(paramPtr, err, name);
  281.       PassReturnValue(CONCAT('Error ', name));
  282.       END;
  283.   
  284.   END;
  285.  
  286. END.